home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / GETENV.INC < prev    next >
Text File  |  1989-08-10  |  7KB  |  196 lines
  1. {************************************************************************}
  2. Unit MyDos;
  3. {                                                                        }
  4. {  VERSION: 1.0c                                                         }
  5. {  Author:  Kevin Lowey                                                  }
  6. {  DATE:    15 Nov. 1987                                                 }
  7. {                                                                        }
  8. {  Description:                                                          }
  9. {     More DOS and BIOS routines not defined by Turbo Pascal             }
  10. {                                                                        }
  11. {************************************************************************}
  12. {                                                                        }
  13. {  Revision History:                                                     }
  14. {      "a" means Alpha version, Not Completed                            }
  15. {      "b" means Beta Test Version, Completed but in testing             }
  16. {      "c" means Completed Version.  This version is now frozen          }
  17. {                                                                        }
  18. {  Date                       Comment                                    }
  19. {  15 Nov. 1987  Added CRTMODE function                                  }
  20. {************************************************************************}
  21.  
  22. Interface
  23. Uses DOS;
  24.  
  25. { CRT mode constants not defined by Turbo Pascal}
  26. CONST
  27.   { BW40 = 0; already defined}
  28.   { CO40 = 1; already defined}
  29.   { BW80 = 2; already defined}
  30.   { CO80 = 3; already defined}
  31.  
  32.   {graphics modes}
  33.   CGAMCO =  4; { 320 * 200 * 4 colors }
  34.   CGAMBW =  5; { 320 * 200 * 4 grey   }
  35.   CGAH   =  6; { 640 * 200 BW}
  36.  
  37.   MONO   =  7; {monochrome graphics adapter}
  38.  
  39.   {PC Junior}
  40.   JRL16  =  8; { PC Jr. 160 * 200 * 16 colors}
  41.   JRM16  =  9; { PC Jr. 320 * 200 * 16 }
  42.   JRH4   = 10; { PC Jr. 640 * 200 * 4 }
  43.  
  44.   {EGA card}
  45.   EGAM64 = 10; { EGA 640 * 200 * 64 COLORS }
  46.   EGAM16 = 13; { EGA 320 * 200 * 16 }
  47.   EGAH16 = 14; { EGA 640 * 200 * 16 }
  48.   EGAXH4 = 15; { EGA 640 * 350 * 4  }
  49.  
  50. Function CRTMode    : byte;  {Current Video Mode}
  51.  
  52. {Cursor Routines}
  53. Procedure SetCursor (startline,EndLine:Byte); {Set cursor style}
  54. Procedure NoCursor;          { Make no cursor show up       }
  55. Procedure BoxCursor;         { Make the cursor a full box   }
  56. Procedure NormCursor;        { Returns the cursor to normal }
  57. function get_env (env_var :String) : String; {Read an environment variable}
  58.  
  59. Implementation
  60. FUNCTION CrtMode : Byte;
  61.  
  62. VAR
  63.   Regs    :  Registers;
  64.  
  65. BEGIN {crtmode function}
  66.   With Regs do BEGIN
  67.     ax := $0F00;                   {VIDEO_IO function 15}
  68.     Intr($10,Regs);
  69.     CrtMode := LO(ax);
  70.   END;
  71. END;  {crtmode function}
  72.  
  73.  
  74. {--------------------------------------------------------------------------}
  75.  
  76. PROCEDURE SetCursor (StartLine,EndLine : byte);
  77.   { This procedure does the actual cursor setting thru the TURBO
  78.     INTR procedure.                                              }
  79.  
  80. VAR
  81.   IntrRegs    :  Registers;
  82.   CXRegArray  :  Array [1..2] of Byte;
  83.   CXReg       :  integer absolute CXRegArray;
  84.  
  85. BEGIN
  86.   CXRegArray[2] := StartLine;
  87.  
  88.   CXRegArray[1] := EndLine;
  89.   With IntrRegs do BEGIN
  90.     ax := $0100;             {ah = 1 means set cursor type}
  91.     bx := $0;                {bx = page number, zero for us}
  92.     cx := CXReg;             {ch bits 4 to 0 = start line for cursor}
  93.                              {cl bits 4 to 0 = end line for cursor}
  94.     intr($10,Dos.Registers(IntrRegs));      {set cursor}
  95.   END;
  96. END;
  97.  
  98. {--------------------------------------------------------------------------}
  99.  
  100. PROCEDURE NoCursor;
  101.  
  102.     { This procedure calls SetCursor to turn the cursor off }
  103.  
  104. BEGIN
  105.   SetCursor(32,0);              {Setting bit 5 turns off cursor}
  106. END;
  107.  
  108. {--------------------------------------------------------------------------}
  109.  
  110. PROCEDURE BoxCursor;
  111.   { This procedure calls SetCursor to show a block (box) cursor }
  112.  
  113. BEGIN
  114.   SetCursor(0,13);              {0-7 for mono, 0-13 for color}
  115.                                 {but 0-13 works ok for mono too}
  116. END;
  117.  
  118. {--------------------------------------------------------------------------}
  119.  
  120. PROCEDURE NormCursor;
  121.   { This procedure calls SetCursor to show the 'normal' cursor }
  122.  
  123. BEGIN
  124.   If CrtMode = 7 then
  125.     SetCursor(11,12)              {mono}
  126.   else
  127.     SetCursor(6,7);               {color}
  128. END;
  129.  
  130. {--------------------------------------------------------------------------}
  131.  
  132. {   This program is a sample on how to control the cursor using TURBO PASCAL
  133.     on an IBM or IBM compatable machine.  It calls the BIOS VIDEO_IO module
  134.     through the standard interupt $10.  This will not work with any machine
  135.     not supporting the standard interupts into the BIOS roms               }
  136.  
  137.  
  138. {************************************************************************}
  139. function get_env
  140.   (env_var: String)   { environment variable to look for                 }
  141.   : String;           { Value of environment variable                    }
  142. {                                                                        }
  143. {  Description:                                                          }
  144. {    Returns the value associated with the given environment variable    }
  145. {                                                                        }
  146. {************************************************************************}
  147. {                                                                        }
  148. {  Revision History:                                                     }
  149. {      "a" means Alpha version, Not Completed                            }
  150. {      "b" means Beta Test Version, Completed but in testing             }
  151. {      "c" means Completed Version.  This version is now frozen          }
  152. {                                                                        }
  153. {************************************************************************}
  154.  
  155. var
  156.   i,j: integer;
  157.   result: String;
  158.   found: boolean;
  159.   table_address: integer;
  160.  
  161. begin  { get_environment }
  162.   result := '';
  163.   i := 0;
  164.   table_address := memW[PrefixSeg:$002c];
  165.  
  166.   if length (env_var) <> 0 then begin
  167.     for j := 1 to length(env_var) do begin {convert to uppercase}
  168.       if env_var[j] in ['a'..'z'] then begin
  169.         env_var[j] := chr(ord(env_var[j])-32);
  170.       end; {then}
  171.     end; {for}
  172.  
  173.     repeat
  174.       result := '';
  175.       while (mem[table_address:i]) <> 0 do begin
  176.         result := result + chr(mem[table_address:i]);
  177.         i := i + 1;
  178.       end;
  179.  
  180.       if pos (env_var,result) = 1 then begin
  181.         found := true;
  182.         result := copy (result,length(env_var) + 1,length(result));
  183.       end
  184.       else
  185.         found := false;
  186.  
  187.       i := i + 1;
  188.     until found or (result = '');
  189.  
  190.   end; { Then find value }
  191.   get_env := result;
  192.  
  193. end;  {get_env}
  194.  
  195. begin
  196. end.